home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Debug / HVBordebug / BorDebugDumpScanner.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-10-02  |  26.5 KB  |  673 lines
  1. unit BorDebugDumpScanner;
  2.  
  3. interface
  4.  
  5. uses BorDebug, HVBorDebug, BorDebugScanners;
  6.  
  7. type
  8.   TDumpEvent = procedure (Sender: TObject; const Msg: string) of object;
  9.   TDumpBorDebugScanner = class(TCustomBorDebugScanner)
  10.   private
  11.     FIndentCount: integer;
  12.     FFirstDump: boolean;
  13.     FOnDump: TDumpEvent;
  14.     procedure ScanNameIndices(NameIndices: PNameIndices; NameCount: TItemCount);
  15.     procedure ScanRegNameIndices(RegNameIndices: PRegNameIndices;
  16.                                  StartEntries  : PSegmentOffsets;
  17.                                  LengthEntries : PByteCounts;
  18.                                  RegNameCount  : TItemCount);
  19.     procedure Dump(S: string);
  20.     procedure DumpFmt(const S: string; const Args: array of const);
  21.     procedure DumpLn(const S: string);
  22.     procedure DumpLnFmt(const S: string; const Args: array of const);
  23.     procedure Indent;
  24.     procedure Unindent;
  25.   protected
  26.     function WantTypeInfoForSymbol(SymbolInfo: TSymbolInfo; TypeIndex: TTypeIndex): boolean; override;
  27.     function WantFieldList(const SubSection: TBorDebugSubSection;
  28.       SymbolInfo: TSymbolInfo; const BorDebugType: TBorDebugType): boolean; override;
  29.     procedure ScanSrcModuleSource(const SubSection: TBorDebugSubSection;
  30.       SrcModule: TBorDebugSrcModule; SourceIndex: integer;
  31.       SourceOffset: TFileOffset; NameIndex: TNameIndex;
  32.       RangeCount: TItemCount; SourceFileEntry: TSourceFileEntry); override;
  33.     procedure ScanSrcModuleRange(const SubSection: TBorDebugSubSection;
  34.       SrcModule: TBorDebugSrcModule; RangeIndex: integer;
  35.       RangeSegmentIndex: TSegmentIndex; RangeStart,
  36.       RangeEnd: TSegmentOffset);  override;
  37.     procedure ScanSymbolTypeInfo(const SubSection: TBorDebugSubSection;
  38.       SymbolInfo: TSymbolInfo; TypeInfo: TTypeInfo; var KeepIt: boolean); override;
  39.     procedure ScanModuleSegment(const SubSection: TBorDebugSubSection;
  40.       Module: TBorDebugModule;  SegmentIndex: integer;
  41.       const Segment: TModuleSegment); override;
  42.     procedure ScanSrcModule(const SubSection: TBorDebugSubSection;
  43.       SrcModule: TBorDebugSrcModule; var KeepIt: boolean);  override;
  44.     procedure ScanSymbolInfo(const SubSection: TBorDebugSubSection;
  45.       SymbolInfo: TSymbolInfo; var KeepIt: boolean);  override;
  46.     procedure ScanModule(const SubSection: TBorDebugSubSection;
  47.       Module: TBorDebugModule; var KeepIt: boolean); override;
  48.     procedure ScanSubSection(SubSectionIndex: integer; const SubSection: TBorDebugSubSection); override;
  49.     procedure ScanLineNumberOffset(LineNumber: TLineNumber;
  50.       LineOffset: TSegmentOffset); override;
  51.     procedure ScanSrcModuleSourceRange(RangeIndex: integer;
  52.       Segment: TSegmentIndex; Starts, Ends: TSegmentOffset;
  53.       LineNumberCount: TItemCount; LineNumberOffsets: TLineNumberOffsets); override;
  54.   public
  55.     property IndentCount: integer read FIndentCount;
  56.     property FirstDump: boolean read FFirstDump;
  57.     property OnDump: TDumpEvent read FOnDump write FOnDump;
  58.   end;
  59.  
  60. implementation
  61.  
  62. uses Windows, SysUtils;
  63.  
  64. procedure TDumpBorDebugScanner.Indent;
  65. begin
  66.   Inc(FIndentCount, 1);
  67.   FFirstDump := true;
  68. end;
  69.  
  70. procedure TDumpBorDebugScanner.Unindent;
  71. begin
  72.   Dec(FIndentCount, 1);
  73.   FFirstDump := true;
  74. end;
  75.  
  76. procedure TDumpBorDebugScanner.Dump(S: string);
  77. var
  78.   i : integer;
  79. begin
  80.   if FirstDump then
  81.     for i := 1 to IndentCount do
  82.       S := '  ' + S;
  83.   if Assigned(FOnDump) then
  84.     FOnDump(Self, S);
  85.   FFirstDump := false;
  86. end;
  87.  
  88. procedure TDumpBorDebugScanner.DumpLn(const S: string);
  89. begin
  90.   Dump(S+#13#10);
  91.   FFirstDump := true;
  92. end;
  93.  
  94. procedure TDumpBorDebugScanner.DumpFmt(const S: string; const Args: array of const);
  95. begin
  96.   Dump(Format(S, Args));
  97. end;
  98.  
  99. procedure TDumpBorDebugScanner.DumpLnFmt(const S: string; const Args: array of const);
  100. begin
  101.   DumpLn(Format(S, Args));
  102. end;
  103.  
  104. function TDumpBorDebugScanner.WantFieldList(const SubSection: TBorDebugSubSection; SymbolInfo: TSymbolInfo; const BorDebugType: TBorDebugType): boolean;
  105. begin
  106.   case SymbolInfo.Kind of
  107.     BORDEBUG_S_PCONSTANT,
  108.     BORDEBUG_S_BPREL32 : Result := False;
  109.     else                 Result := True;
  110.   end;
  111. end;
  112.  
  113. function TDumpBorDebugScanner.WantTypeInfoForSymbol(
  114.   SymbolInfo: TSymbolInfo; TypeIndex: TTypeIndex): boolean;
  115. begin
  116.   case SymbolInfo.Kind of
  117.     BORDEBUG_S_PCONSTANT: Result := False;
  118.     else                  Result := True;
  119.   end;
  120. end;
  121.  
  122. procedure TDumpBorDebugScanner.ScanModuleSegment(
  123.   const SubSection: TBorDebugSubSection;
  124.         Module: TBorDebugModule;
  125.         SegmentIndex: integer;
  126.   const Segment: TModuleSegment);
  127. begin
  128.   DumpFmt('%d.', [SegmentIndex]);
  129.   case Segment.Flags of
  130.     sfDataSegment : Dump(' (DS)');
  131.     sfCodeSegment : Dump(' (CS)');
  132.   end;
  133.   DumpFmt(' Size = %d b', [Segment.Size]);
  134.   DumpLn('');
  135. end;
  136.  
  137. procedure TDumpBorDebugScanner.ScanLineNumberOffset(LineNumber: TLineNumber;
  138.   LineOffset: TSegmentOffset);
  139. begin
  140.   DumpLnFmt('#%d = @%.8x',
  141.     [LineNumber, LineOffset]);
  142.   inherited;
  143. end;
  144.  
  145. procedure TDumpBorDebugScanner.ScanSrcModuleSourceRange(RangeIndex: integer;
  146.   Segment: TSegmentIndex; Starts, Ends: TSegmentOffset;
  147.   LineNumberCount: TItemCount; LineNumberOffsets: TLineNumberOffsets);
  148. begin
  149.   DumpLnFmt('Range#%d, Segment=%d, Start=%.8x, End=%.8x, LineNumbers=%d',
  150.     [RangeIndex, Segment, Starts, Ends, LineNumberCount]);
  151.   Indent;
  152.   inherited;
  153.   UnIndent;
  154. end;
  155.  
  156. procedure TDumpBorDebugScanner.ScanSrcModuleRange(
  157.   const SubSection: TBorDebugSubSection; SrcModule: TBorDebugSrcModule;
  158.   RangeIndex: integer; RangeSegmentIndex: TSegmentIndex; RangeStart,
  159.   RangeEnd: TSegmentOffset);
  160. begin
  161.   DumpLnFmt('Range#%d, Segment=%d, Start=%.8x, End=%.8x',
  162.     [RangeIndex, RangeSegmentIndex, RangeStart, RangeEnd]);
  163.   Indent;
  164.   inherited;
  165.   UnIndent;
  166. end;
  167.  
  168. procedure TDumpBorDebugScanner.ScanSrcModuleSource(
  169.   const SubSection: TBorDebugSubSection; SrcModule: TBorDebugSrcModule;
  170.   SourceIndex: integer; SourceOffset: TFileOffset; NameIndex: TNameIndex;
  171.   RangeCount: TItemCount; SourceFileEntry: TSourceFileEntry);
  172. begin
  173.   DumpLnFmt('File#%d, %s, Offset=%.8x, RangeCount=%d, ',
  174.     [SourceIndex, BorDebug.Names[NameIndex], SourceOffset, RangeCount]);
  175.   Indent;
  176.   inherited;
  177.   UnIndent;
  178. end;
  179.  
  180. procedure TDumpBorDebugScanner.ScanSymbolTypeInfo(
  181.   const SubSection: TBorDebugSubSection; SymbolInfo: TSymbolInfo;
  182.   TypeInfo: TTypeInfo; var KeepIt: boolean);
  183. var
  184.   i : integer;
  185. begin
  186.   if TypeInfo.TypeIndex = 0 then
  187.     Exit;
  188.   DumpFmt('TYPE %s', [TypeInfo.KindAsString]);
  189.   case TypeInfo.TypeKind of
  190.     BORDEBUG_LF_MODIFIER    :
  191.       with TypeInfo.Info.MODIFIERType^ do
  192.         DumpFmt(', Attributes=%d, TypeIndex=%d: %s',
  193.           [Ord(Attributes), TypeIndex, BorDebug.TypeName[TypeIndex]]);
  194.     BORDEBUG_LF_POINTER     :
  195.       with TypeInfo.Info.POINTERType^ do
  196.         DumpFmt(', Attributes=%d, TypeIndex=%d: %s, Value1=%d, Value2=%d',
  197.           [Ord(Attributes), TypeIndex, BorDebug.TypeName[TypeIndex], DWORD(Value1), DWORD(Value2)]);
  198.     BORDEBUG_LF_ARRAY       :
  199.       with TypeInfo.Info.ARRAYType^ do
  200.         DumpFmt(', ElementType=%s, IndexType=%s, Name=%s, Size=%d, Elements=%d',
  201.           [BorDebug.TypeName[ElementType], BorDebug.TypeName[IndexType], BorDebug.Names[NameIndex], Size, Elements ]);
  202.     BORDEBUG_LF_STRUCT,
  203.     BORDEBUG_LF_CLASS       :
  204.       with TypeInfo.Info.CLASSType^ do
  205.       begin
  206.         DumpFmt(', %s, Fields=%d, Size=%d, Flags=%s',
  207.           [BorDebug.Names[NameIndex], FieldCount, ClassSize, ClassFlagsToString(ClassFlags)]);
  208.         if ContainingClass <> 0 then
  209.           DumpFmt(', Contained in class: %s', [BorDebug.TypeName[ContainingClass]]);
  210.         Indent;
  211.         ScanSymbolTypeTree(SubSection, SymbolInfo, FieldList);
  212.         ScanSymbolTypeTree(SubSection, SymbolInfo, DerivationList);
  213.         ScanSymbolTypeTree(SubSection, SymbolInfo, VTable);
  214.         UnIndent;
  215.       end;
  216.     BORDEBUG_LF_UNION       :
  217.       with TypeInfo.Info.UNIONType^ do
  218.       begin
  219.         DumpFmt(', %s, Fields=%d, Size=%d, Flags=%s',
  220.           [BorDebug.Names[NameIndex], FieldCount, ClassSize, ClassFlagsToString(ClassFlags)]);
  221.         if ContainingClass <> 0 then
  222.           DumpFmt(', Contained in class: %s', [BorDebug.TypeName[ContainingClass]]);
  223.         Indent;
  224.         ScanSymbolTypeTree(SubSection, SymbolInfo, FieldList);
  225.         UnIndent;
  226.       end;
  227.     BORDEBUG_LF_ENUM        :
  228.       with TypeInfo.Info.ENUMType^ do
  229.       begin
  230.         DumpFmt(', %s, Members=%d, UnderlyingType=%s',
  231.           [BorDebug.Names[NameIndex], MemberCount, BorDebug.TypeName[UnderlyingType]]);
  232.         if ContainingClass <> 0 then
  233.           DumpFmt(', Contained in class: %s', [BorDebug.TypeName[ContainingClass]]);
  234.         Indent;
  235.         ScanSymbolTypeTree(SubSection, SymbolInfo, MemberList);
  236.         UnIndent;
  237.       end;
  238.     BORDEBUG_LF_PROCEDURE   :
  239.       with TypeInfo.Info.PROCEDUREType^ do
  240.       begin
  241.         DumpFmt(', ReturnType=%s, CallConv=%s, Args=%d',
  242.           [BorDebug.TypeName[ReturnType], CallingConventionToString(CallingConvention), ArgCount]);
  243.         Indent;
  244.         ScanSymbolTypeTree(SubSection, SymbolInfo, ArgList);
  245.         UnIndent;
  246.       end;
  247.     BORDEBUG_LF_MFUNCTION   :
  248.       with TypeInfo.Info.MFUNCTIONType^ do
  249.       begin
  250.         DumpFmt(', ReturnType=%s, CallConv=%s, Args=%d, ClassType=%s, ThisAdjust=%.8x',
  251.           [BorDebug.TypeName[ReturnType], CallingConventionToString(CallingConvention), ArgCount, BorDebug.TypeName[ClassType], ThisAdjust]);
  252.         if ClassType = 0 then
  253.           Dump(', static')
  254.         else
  255.         DumpFmt(', ClassType=%s',
  256.           [BorDebug.TypeName[ClassType]]);
  257.       end;
  258.     BORDEBUG_LF_VTSHAPE     :
  259.       with TypeInfo.Info.VTSHAPEType^ do
  260.       begin
  261.         DumpFmt(', DescriptorCount=%.8x',
  262.           [DescriptorCount]);
  263.         Indent;
  264.         for i := 0 to DescriptorCount-1 do
  265.           DumpFmt(' %d,', [DWORD(DescriptorArray^[i])]);
  266.         UnIndent;
  267.       end;
  268.     BORDEBUG_LF_LABEL       :
  269.       with TypeInfo.Info.LABELType^ do
  270.         DumpFmt(', NearFar=%.8x',
  271.           [Ord(NearFar)]);
  272.     BORDEBUG_LF_SET         :
  273.       with TypeInfo.Info.SETType^ do
  274.         DumpFmt(', %s, ElemType=%s, LowByte=%d, Length=%d',
  275.           [BorDebug.Names[NameIndex], BorDebug.TypeName[ElemType], LowByte, Length]);
  276.     BORDEBUG_LF_SUBRANGE    :
  277.       with TypeInfo.Info.SUBRANGEType^ do
  278.         DumpFmt(', %s, BaseType=%s, LoBound=%d, HiBound=%d, Size=%d',
  279.           [BorDebug.Names[NameIndex], BorDebug.TypeName[BaseType], LoBound, HiBound, Size]);
  280.     BORDEBUG_LF_PARRAY      :
  281.       with TypeInfo.Info.PARRAYType^ do
  282.         DumpFmt(', %s, ElementType=%s, IndexType=%s, Size=%d, Elements=%d',
  283.           [BorDebug.Names[NameIndex], BorDebug.TypeName[ElementType], BorDebug.TypeName[IndexType], Size, Elements]);
  284.     BORDEBUG_LF_PSTRING     :
  285.       with TypeInfo.Info.PSTRINGType^ do
  286.         DumpFmt(', %s, ElemType=%s, IndexType=%s',
  287.           [BorDebug.Names[NameIndex], BorDebug.TypeName[ElemType], BorDebug.TypeName[IndexType]]);
  288.     BORDEBUG_LF_CLOSURE     :
  289.       with TypeInfo.Info.CLOSUREType^ do
  290.       begin
  291.         DumpFmt(', ReturnType=%s, CallConv=%s, Args=%d',
  292.           [BorDebug.TypeName[ReturnType], CallingConventionToString(CallingConvention), ArgCount]);
  293.         Indent;
  294.         ScanSymbolTypeTree(SubSection, SymbolInfo, ArgList);
  295.         UnIndent;
  296.       end;
  297.     BORDEBUG_LF_PROPERTY    :
  298.       with TypeInfo.Info.PROPERTYType^ do
  299.       begin
  300.         DumpFmt(', Type=%s, Flags=%s, ArrayIndex=%d, PropIndex=%d',
  301.           [BorDebug.TypeName[TypeIndex], PropertyFlagsToString(Flags), ArrayIndex, PropIndex]);
  302.         if  pfReadIsName in Flags then
  303.           DumpFmt(', ReadSlot=%s', [BorDebug.Names[ReadSlot.NameIndex]])
  304.         else
  305.           DumpFmt(', ReadSlot=%d', [BorDebug.Names[ReadSlot.FieldOffset]]);
  306.  
  307.         if  pfWriteIsName in Flags then
  308.           DumpFmt(', WriteSlot=%s', [BorDebug.Names[WriteSlot.NameIndex]])
  309.         else
  310.           DumpFmt(', WriteSlot=%d', [BorDebug.Names[WriteSlot.FieldOffset]]);
  311.       end;
  312.     BORDEBUG_LF_LSTRING     :
  313.       with TypeInfo.Info.LSTRINGType^ do
  314.         DumpFmt(', ''%s''',
  315.           [BorDebug.Names[NameIndex]]);
  316.     BORDEBUG_LF_VARIANT     :
  317.       with TypeInfo.Info.VARIANTType^ do
  318.         DumpFmt(', ''%s''',
  319.           [BorDebug.Names[NameIndex]]);
  320.     BORDEBUG_LF_CLASSREF    :
  321.       with TypeInfo.Info.CLASSREFType^ do
  322.         DumpFmt(', Class=%s, VtShape=%s',
  323.           [BorDebug.TypeName[RefType], BorDebug.TypeName[VtShape]]);
  324.     BORDEBUG_LF_WSTRING     :
  325.       with TypeInfo.Info.LSTRINGType^ do
  326.         DumpFmt(', ''%s''',
  327.           [BorDebug.Names[NameIndex]]);
  328.     BORDEBUG_LF_ARGLIST     :
  329.       with TypeInfo.Info.ARGLISTType^ do
  330.       begin
  331.         DumpFmt(', TypeCount=%.8x',
  332.           [TypeCount]);
  333.         Indent;
  334.         for i := 0 to TypeCount-1 do
  335.           DumpFmt(' %s,', [BorDebug.TypeName[TypeArray^[i]]]);
  336.         UnIndent;
  337.       end;
  338.     BORDEBUG_LF_DERIVED     :
  339.       with TypeInfo.Info.DERIVEDType^ do
  340.       begin
  341.         DumpFmt(', TypeCount=%.8x',
  342.           [TypeCount]);
  343.         Indent;
  344.         for i := 0 to TypeCount-1 do
  345.           DumpFmt(' %s,', [BorDebug.TypeName[DerivedTypes^[i]]]);
  346.         UnIndent;
  347.       end;
  348.     BORDEBUG_LF_BITFIELD    :
  349.       with TypeInfo.Info.BITFIELDType^ do
  350.         DumpFmt(', Type=%s, Length=%d, Position=%d',
  351.           [BorDebug.TypeName[TypeIndex], Length, Position]);
  352.     BORDEBUG_LF_METHODLIST  :
  353.       with TypeInfo.Info.METHODLISTType^ do
  354.       begin
  355.         DumpFmt(', MethodCount=%.8x',
  356.           [MethodCount]);
  357.         Indent;
  358.         for i := 0 to MethodCount-1 do
  359.           DumpLnFmt('Type=%s, Attrib=%s, VTabOff=%.8x',
  360.             [BorDebug.TypeName[TypeArray^[i]], ClassMemberAttribToString(AttribArray^[i]), VtabOffArray^[i]]);
  361.         UnIndent;
  362.       end;
  363.     BORDEBUG_LF_BCLASS      :
  364.       with TypeInfo.Info.BCLASSType^ do
  365.         DumpFmt(', Type=%s, Attrib=%s, Offset=%.8x',
  366.           [BorDebug.TypeName[BaseType], ClassMemberAttribToString(Attrib), Offset]);
  367.     BORDEBUG_LF_VBCLASS     :
  368.       with TypeInfo.Info.VBCLASSType^ do
  369.         DumpFmt(', vbType=%s, vbpType=%s, Attrib=%s, Offset=%.8x, VbpOffset=%.8x',
  370.           [BorDebug.TypeName[vbType], BorDebug.TypeName[vbpType], ClassMemberAttribToString(Attrib), Offset, VbpOffset]);
  371.     BORDEBUG_LF_IVBCLASS    :
  372.       with TypeInfo.Info.IVBCLASSType^ do
  373.         DumpFmt(', vbType=%s, vbpType=%s, Attrib=%s, Offset=%.8x, VbpOffset=%.8x',
  374.           [BorDebug.TypeName[vbType], BorDebug.TypeName[vbpType], ClassMemberAttribToString(Attrib), Offset, VbpOffset]);
  375.     BORDEBUG_LF_ENUMERATE   :
  376.       with TypeInfo.Info.ENUMERATEType^ do
  377.         DumpFmt(', Name=%s, Value=%d',
  378.           [BorDebug.Names[NameIndex], Value]);
  379.     BORDEBUG_LF_FRIENDFCN   :
  380.       with TypeInfo.Info.FRIENDFCNType^ do
  381.         DumpFmt(', %s:%s',
  382.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex]]);
  383.     BORDEBUG_LF_INDEX       :
  384.       with TypeInfo.Info.INDEXTypeR^ do
  385.         DumpFmt(', Type=%s',
  386.           [BorDebug.TypeName[TypeIndex]]);
  387.     BORDEBUG_LF_MEMBER      :
  388.       with TypeInfo.Info.MEMBERType^ do
  389.         DumpFmt(', %s:%s, Attrib=%s, Offset=%.8x',
  390.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], ClassMemberAttribToString(Attrib), Offset]);
  391.     BORDEBUG_LF_STMEMBER    :
  392.       with TypeInfo.Info.STMEMBERType^ do
  393.         DumpFmt(', %s:%s, Attrib=%s',
  394.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], ClassMemberAttribToString(Attrib)]);
  395.     BORDEBUG_LF_METHOD      :
  396.       with TypeInfo.Info.METHODType^ do
  397.       begin
  398.         DumpFmt(', Name=%s, OverloadedCount=%d',
  399.           [BorDebug.Names[NameIndex], OverloadedCount]);
  400.         Indent;
  401.         ScanSymbolTypeTree(SubSection, SymbolInfo, MethodList);
  402.         UnIndent;
  403.       end;
  404.     BORDEBUG_LF_NESTTYPE    :
  405.       with TypeInfo.Info.NESTTYPEType^ do
  406.         DumpFmt(', %s:%s',
  407.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex]]);
  408.     BORDEBUG_LF_VFUNCTAB    :
  409.       with TypeInfo.Info.VFUNCTABType^ do
  410.         DumpFmt(', Type=%s, Offset=%.8x',
  411.           [BorDebug.TypeName[TypeIndex], Offset]);
  412.     BORDEBUG_LF_FRIENDCLS   :
  413.       with TypeInfo.Info.FRIENDCLSType^ do
  414.         DumpFmt(', Type=%s',
  415.           [BorDebug.TypeName[TypeIndex]]);
  416.     BORDEBUG_LF_CHAR        :
  417.       with TypeInfo.Info.CHARType^ do DumpFmt(', Value=%s', [Value]);
  418.     BORDEBUG_LF_SHORT       :
  419.       with TypeInfo.Info.SHORTType^ do
  420.         DumpFmt(', Value=%d',
  421.           [Value]);
  422.     BORDEBUG_LF_USHORT   : with TypeInfo.Info.USHORTType^    do DumpFmt(', Value=%d', [Value]);
  423.     BORDEBUG_LF_LONG     : with TypeInfo.Info.LONGType^      do DumpFmt(', Value=%d', [Value]);
  424.     BORDEBUG_LF_ULONG    : with TypeInfo.Info.ULONGType^     do DumpFmt(', Value=%d', [Value]);
  425.     BORDEBUG_LF_REAL32   : with TypeInfo.Info.REAL32Type^    do DumpFmt(', Value=%g', [Value]);
  426.     BORDEBUG_LF_REAL64   : with TypeInfo.Info.REAL64Type^    do DumpFmt(', Value=%g', [Value]);
  427.     BORDEBUG_LF_REAL80   : with TypeInfo.Info.REAL80Type^    do DumpFmt(', Value=%g', [Value]);
  428.     BORDEBUG_LF_QUADWORD : with TypeInfo.Info.QUADWORDType^  do DumpFmt(', Value=%d', [Value]);
  429.     BORDEBUG_LF_UQUADWORD: with TypeInfo.Info.UQUADWORDType^ do DumpFmt(', Value=%d', [Value]);
  430.     BORDEBUG_LF_REAL48   : with TypeInfo.Info.REAL48Type^    do DumpFmt(', Value=%g', [Value]);
  431.   end;
  432.   DumpLn('');
  433.   Indent;
  434.   inherited;
  435.   UnIndent;
  436. end;
  437.  
  438.  
  439. procedure TDumpBorDebugScanner.ScanSrcModule(const SubSection: TBorDebugSubSection;
  440.   SrcModule: TBorDebugSrcModule; var KeepIt: boolean);
  441. begin
  442.   with SrcModule do
  443.     DumpLnFmt('SRCMODULE (%.8x): %d Range(s), %d Sourcefile(s), %',
  444.               [Offset, RangeCount, SourceCount]);
  445.   Indent;
  446.   inherited;
  447.   UnIndent;
  448. end;
  449.  
  450. procedure TDumpBorDebugScanner.ScanNameIndices(NameIndices: PNameIndices; NameCount: TItemCount);
  451. var
  452.   i : integer;
  453. begin
  454.   Indent;
  455.   DumpLn('');
  456.   for i := 0 to NameCount-1 do
  457.   begin
  458.     Dump(BorDebug.Names[NameIndices^[i]]);
  459.     if i < NameCount-1 then
  460.       DumpLn(',')
  461.     else
  462.       Dump(';')
  463.   end;
  464.   UnIndent;
  465. end;
  466.  
  467. procedure TDumpBorDebugScanner.ScanRegNameIndices(RegNameIndices: PRegNameIndices;
  468.                                                 StartEntries  : PSegmentOffsets;
  469.                                                 LengthEntries : PByteCounts;
  470.                                                 RegNameCount  : TItemCount);
  471. var
  472.   i : integer;
  473. begin
  474.   Indent;
  475.   DumpLn('');
  476.   for i := 0 to RegNameCount-1 do
  477.   begin
  478.     DumpFmt('Reg: %s, Start=%.8x, Length=%.8x',
  479.       [BorDebug.RegisterName[RegNameIndices^[i]], StartEntries^[i], LengthEntries^[i]]);
  480.     if i < RegNameCount-1 then
  481.       DumpLn('');
  482.   end;
  483.   UnIndent;
  484. end;
  485.  
  486. procedure TDumpBorDebugScanner.ScanSymbolInfo(const SubSection: TBorDebugSubSection;
  487.   SymbolInfo: TSymbolInfo; var KeepIt: boolean);
  488. begin
  489.   if SymbolInfo.Kind = BORDEBUG_S_END then
  490.     UnIndent
  491.   else
  492.     DumpFmt('SYMBOL: %s', [SymbolInfo.KindAsString]);
  493.   case SymbolInfo.Kind of
  494.     BORDEBUG_S_COMPILE   :
  495.       with SymbolInfo.Info.COMPILESymbol^ do
  496.         DumpFmt(', Machine=%d, Language=%d, Flags=%.8x, Compiler=%s',
  497.           [Ord(Machine), Ord(Language), Flags, CompilerName]);
  498.     BORDEBUG_S_REGISTER  :
  499.       with SymbolInfo.Info.REGISTERSymbol^ do
  500.         DumpFmt(', Type=%s, Register=%s, Name=%s',
  501.           [BorDebug.TypeName[TypeIndex], BorDebug.RegisterName[RegisterIndex], BorDebug.Names[NameIndex]]);
  502.     BORDEBUG_S_CONST     :
  503.       with SymbolInfo.Info.CONSTSymbol^ do
  504.         DumpFmt(', %s:%s = %.8x',
  505.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Value]);
  506.     BORDEBUG_S_UDT       :
  507.       with SymbolInfo.Info.UDTSymbol^ do
  508.       begin
  509.         DumpFmt(' %s: %s',
  510.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex]]);
  511.         if udtTag in Properties then
  512.           Dump(', Tag');
  513.         if udtNested in Properties then
  514.           Dump(', Nested');
  515.       end;
  516.     BORDEBUG_S_SSEARCH   :
  517.       with SymbolInfo.Info.SSEARCHSymbol^ do
  518.         DumpFmt(', FirstProcSegment=%d, FirstProcOffset=%.8x, CodeSymCount=%d, DataSymCount=%d, FirstData=%.8x',
  519.             [FirstProcSegment, FirstProcOffset, CodeSymCount, DataSymCount, FirstData]);
  520.     BORDEBUG_S_OBJNAME   :
  521.       with SymbolInfo.Info.OBJNAMESymbol^ do
  522.         DumpFmt(', Name=%s, Signature=%.8x',
  523.           [BorDebug.Names[NameIndex], Signature]);
  524.     BORDEBUG_S_USES      :
  525.       with SymbolInfo.Info.USESSymbol^ do
  526.         ScanNameIndices(NameIndices, NameCount);
  527.     BORDEBUG_S_USING     :
  528.       with SymbolInfo.Info.USINGSymbol^ do
  529.         ScanNameIndices(NameIndices, NameCount);
  530.     BORDEBUG_S_PCONSTANT :
  531.       with SymbolInfo.Info.PCONSTANTSymbol^ do
  532.         DumpFmt(', %s: %s = %s',
  533.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Value]); // Properties
  534.     BORDEBUG_S_NAMESPACE :
  535.       with SymbolInfo.Info.NAMESPACESymbol^ do
  536.       begin
  537.         DumpFmt(', Name=%s',
  538.           [BorDebug.Names[NameIndex]]);
  539.         ScanNameIndices(UsingIndices, UsingCount);
  540.       end;
  541.     BORDEBUG_S_GPROCREF  :
  542.       with SymbolInfo.Info.GPROCREFSymbol^ do
  543.         DumpFmt(', %s: %s; RefSymOffset=%.8x, CodeSegment=%d, CodeOffset=%.8x',
  544.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], RefSymOffset, CodeSegment, CodeOffset]);
  545.     BORDEBUG_S_GDATAREF  :
  546.       with SymbolInfo.Info.GDATAREFSymbol^ do
  547.         DumpFmt(', %s: %s; RefSymOffset=%.8x, DataSegment=%d, DataOffset=%.8x',
  548.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], RefSymOffset, DataSegment, DataOffset]);
  549.     BORDEBUG_S_LPROC32   :
  550.       with SymbolInfo.Info.LPROC32Symbol^ do
  551.       begin
  552.         DumpLnFmt(', %s: %s; Flags=%.8x, Offset=%.8x, Segment=%.8x',
  553.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Flags, Offset, Segment]);
  554.         DumpFmt('  Parent=%.8x, End_=%.8x, Next=%.8x, CodeLength=%.8x, DebugStart=%.8x, DebugEnd=%.8x',
  555.           [Parent, End_, Next, CodeLength, DebugStart, DebugEnd]);
  556.         Indent;
  557.       end;
  558.     BORDEBUG_S_GPROC32   :
  559.       with SymbolInfo.Info.GPROC32Symbol^ do
  560.       begin
  561.         DumpLnFmt(', %s: %s; Flags=%.8x, Offset=%.8x, Segment=%.8x',
  562.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Flags, Offset, Segment]);
  563.         DumpFmt('  Parent=%.8x, End_=%.8x, Next=%.8x, CodeLength=%.8x, DebugStart=%.8x, DebugEnd=%.8x',
  564.           [Parent, End_, Next, CodeLength, DebugStart, DebugEnd]);
  565.         if Assigned(LinkName) then
  566.           DumpFmt(', LinkName=%s', [string(LinkName)]);
  567.         Indent;
  568.       end;
  569.     BORDEBUG_S_GDATA32   :
  570.       with SymbolInfo.Info.GDATA32Symbol^ do
  571.       begin
  572.         DumpFmt(', %s: %s; Offset=%.8x, Segment=%.8x',
  573.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Offset, Segment]);
  574.         if Flags = efTLS then
  575.           Dump(', TLS');
  576.       end;
  577.     BORDEBUG_S_OPTVAR32  :
  578.       with SymbolInfo.Info.OPTVAR32Symbol^ do
  579.         ScanRegNameIndices(RegNameEntries, StartEntries, LengthEntries, EntryCount);
  580.     BORDEBUG_S_LDATA32   :
  581.       with SymbolInfo.Info.LDATA32Symbol^ do
  582.       begin
  583.         DumpFmt(', %s: %s; Offset=%.8x, Segment=%.8x',
  584.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Offset, Segment]);
  585.         if Flags = efTLS then
  586.           Dump(', TLS');
  587.       end;
  588.     BORDEBUG_S_EDATA     :
  589.       with SymbolInfo.Info.EDATASymbol^ do
  590.       begin
  591.         DumpFmt(', %s: %s; ExternIndex=%.8x',
  592.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], ExternIndex]);
  593.         if Flags = efTLS then
  594.           Dump(', TLS');
  595.       end;
  596.     BORDEBUG_S_EPROC     :
  597.       with SymbolInfo.Info.EPROCSymbol^ do
  598.         DumpFmt(', %s: %s; ExternIndex=%.8x',
  599.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], ExternIndex]);
  600.     BORDEBUG_S_BPREL32   :
  601.       with SymbolInfo.Info.BPREL32Symbol^ do
  602.         DumpFmt(', %s: %s; EBPOffset=%.8x',
  603.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], EBPOffset]);
  604.     BORDEBUG_S_PUB32     :
  605.       with SymbolInfo.Info.PUB32Symbol^ do
  606.       begin
  607.         DumpFmt(', %s: %s; Offset=%.8x, Segment=%.8x',
  608.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Offset, Segment]);
  609.         if Flags = efTLS then
  610.           Dump(', TLS');
  611.       end;
  612.     BORDEBUG_S_THUNK32   :
  613.       with SymbolInfo.Info.THUNK32Symbol^ do
  614.         DumpFmt(', %s; Offset=%.8x, Segment=%.8x, Parent=%.8x, End_=%.8x, Next=%.8x, CodeLength=%.8x, Ordinal=%.8x, Delta=%.8x',
  615.           [BorDebug.Names[NameIndex], Offset, Segment, Parent, End_, Next, CodeLength, DWORD(Ordinal), Delta]);
  616.     BORDEBUG_S_BLOCK32   :
  617.       with SymbolInfo.Info.BLOCK32Symbol^ do
  618.         DumpFmt(', %s; Offset=%.8x, Segment=%.8x, Parent=%.8x, End_=%.8x, CodeLength=%.8x',
  619.           [BorDebug.Names[NameIndex], Offset, Segment, Parent, End_, CodeLength]);
  620.     BORDEBUG_S_WITH32    :
  621.       with SymbolInfo.Info.WITH32Symbol^ do
  622.         DumpFmt(', %s: %s; Offset=%.8x, Segment=%.8x, Parent=%.8x, CodeLength=%.8x, VarOffset=%.8x',
  623.           [BorDebug.Names[NameIndex], BorDebug.TypeName[TypeIndex], Offset, Segment, Parent, CodeLength, VarOffset]);
  624.     BORDEBUG_S_LABEL32   :
  625.       with SymbolInfo.Info.LABEL32Symbol^ do
  626.         DumpFmt(', %s; Offset=%.8x, Segment=%.8x, NearFar=%.8x',
  627.           [BorDebug.Names[NameIndex], Offset, Segment, Ord(NearFar)]);
  628.     BORDEBUG_S_ENTRY32   :
  629.       with SymbolInfo.Info.ENTRY32Symbol^ do
  630.         DumpFmt(', Offset=%.8x, Segment=%.8x',
  631.           [Offset, Segment]);
  632.     BORDEBUG_S_PROCRET32 :
  633.       with SymbolInfo.Info.PROCRET32Symbol^ do
  634.         DumpFmt(', Offset=%.8x, Length=%.8x',
  635.           [Offset, Length]);
  636.     BORDEBUG_S_SAVREGS32 :
  637.       with SymbolInfo.Info.SAVREGS32Symbol^ do
  638.         DumpFmt(', Mask=%s, EBPOffset=%.8x',
  639.           [SaveRegsToString(Mask), EBPOffset]);
  640.     BORDEBUG_S_SLINK32   :
  641.       with SymbolInfo.Info.SLINK32Symbol^ do
  642.         DumpFmt(', EBPOffset=%.8x',
  643.           [EBPOffset]);
  644.   end;
  645.   DumpLn('');
  646.   Indent;
  647.   inherited;
  648.   UnIndent;
  649. end;
  650.  
  651. procedure TDumpBorDebugScanner.ScanModule(const SubSection: TBorDebugSubSection;
  652.   Module: TBorDebugModule; var KeepIt: boolean);
  653. begin
  654.   with Module do
  655.     DumpLnFmt('MODULE: %s, Overlay=%d, LibIndex=%d, Style=%.8x, TimeStamp=%.8x, SegmentCount = %d',
  656.       [Name, Overlay, LibIndex, Style, TimeStamp, SegmentCount]);
  657.   Indent;
  658.   inherited;
  659.   UnIndent;
  660. end;
  661.  
  662. procedure TDumpBorDebugScanner.ScanSubSection(SubSectionIndex: integer; const SubSection: TBorDebugSubSection);
  663. begin
  664.   with SubSection do
  665.     DumpLnFmt('SUBSECTION #%d: %s, ModuleIndex=%d, Offset=%.8x, Size=%d',
  666.       [SubSectionIndex, SubsectionTypeToString(SubSection.SubsectionType), Module, Offset, Size]);
  667.   Indent;
  668.   inherited;
  669.   UnIndent;
  670. end;
  671.  
  672. end.
  673.